home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / lsp / sloop.data < prev    next >
Encoding:
Text File  |  1992-02-08  |  19.6 KB  |  18 lines
  1.        
  2. #(#! 
  3. (lisp::in-package "SLOOP" :use (lisp::quote (user::lisp)))#! 
  4. (lisp::export (lisp::quote (sloop::loop-return sloop::sloop sloop::def-loop-collect sloop::def-loop-map sloop::def-loop-for sloop::def-loop-macro sloop::local-finish sloop::loop-finish)) (lisp::find-package "SLOOP"))
  5. #(:collect (sloop::loop-collect-keyword-p sloop::.item.) :no-body (sloop::parse-no-body sloop::.item.) (:sloop-macro :sloop-for :sloop-map) lisp::and (lisp::symbolp sloop::.item.) lisp::get sloop::.item. sloop::l-equal lisp::quote (lisp::t (lisp::error "lcase fell off end ~a  " sloop::.item.)) lisp::let sloop::translate-name lisp::cond lisp::setf lisp::progn lisp::car lisp::cdr "" lisp::return lisp::values (lisp::go sloop::finish-loop) (lisp::go sloop::finish-loop) lisp::map sloop::for lisp::macro sloop::collect sloop::*additional-collections* (lisp::progn (lisp::rotatef sloop::a sloop::*loop-bindings*) (lisp::rotatef sloop::b sloop::*loop-prologue*) (lisp::rotatef sloop::c sloop::*loop-epilogue*) (lisp::rotatef sloop::e sloop::*loop-end-test*) (lisp::rotatef sloop::f sloop::*loop-increment*) (lisp::setf sloop::*inner-sloop* (lisp::not sloop::*inner-sloop*))) :test (sloop::collect lisp::append lisp::nconc sloop::sum lisp::count) sloop::*sloop-translations* :key sloop::*loop-form* sloop::*last-val* sloop::empty-form "you are un-popping without popping" sloop::alread-un-popped sloop::*type-test-limit* sloop::*product-for* sloop::*loop-end-test* sloop::*loop-increment* sloop::*loop-epilogue* sloop::*loop-map-declares* sloop::*loop-collect-var* sloop::*loop-bindings* sloop::*no-declare* sloop::*loop-prologue* sloop::*loop-body* sloop::*inner-sloop* sloop::*loop-name* sloop::*loop-collect-pointers* sloop::*loop-map* sloop::*automatic-declarations* sloop::finish-loop lisp::do "SLOOP" "FINISH" sloop::loop-return (lisp::&rest sloop::vals) lisp::list (lisp::quote lisp::return-from) (lisp::list* (lisp::quote lisp::values) sloop::vals) sloop::loop-finish (lisp::quote lisp::go) sloop::local-finish (lisp::quote lisp::go) lisp::return-from sloop::next-loop ((lisp::go sloop::next-loop)) lisp::macrolet lisp::block lisp::tagbody ((sloop::loop-return lisp::nil)) lisp::*macroexpand-hook* sloop::*macroexpand-hook-for-no-copy* lisp::declare sloop::named sloop::while lisp::or (sloop::local-finish) sloop::until (sloop::local-finish) (lisp::when lisp::unless) "lcase fell off end ~a  " (sloop::initially sloop::finally) sloop::with sloop::nodeclare sloop::increment sloop::end-test sloop::with-unique :sloop-macro sloop::done lisp::= "Not a variable ~a" "empty clause" sloop::initially (lisp::setf lisp::setq) sloop::finally sloop::body lisp::when "Premature AND" "Hanging conditional" lisp::unless lisp::not sloop::else "POIN" sloop::into "COLL" (lisp::append lisp::nconc sloop::collect) sloop::*use-locatives* sloop::locf lisp::equal lisp::append lisp::copy-list "VAL" (lisp::nconc lisp::append) lisp::last lisp::cons "loop fell off end ~a" :sloop-collect lisp::type lisp::the "While checking a bound of a sloop, I found the wrong type 
  6. for something in sloop::*automatic-declarations*.
  7.     Perhaps your limit is wrong? 
  8. If not either use nodeclare t or set sloop::*automatic-declarations* to nil. 
  9. recompile." sloop::*type-check* :from sloop::the-value "~&Sloop found the type of ~a was not type ~a,~%~
  10.                       Maybe you want to insert SLOOP NODECLARE T ..." lisp::typep (sloop::type-error) sloop::*auto-type* sloop::*auto-register* :register "Could not find variable ~a in bindings" (lisp::nil 0 lisp::nil 1 lisp::+ lisp::nil) sloop::in "LIS" :in sloop::desetq lisp::null sloop::on "LIS" (sloop::upfrom sloop::from) lisp::+ sloop::downfrom lisp::- lisp::by lisp::*print-level* lisp::*print-length* "" "The assertion ~:@(~S~) is failed." (lisp::eq (lisp::car (lisp::third sloop::incr)) (lisp::quote lisp::cdr)) lisp::*error-output* "Now continuing ...~%" (lisp::quote lisp::function) lisp::funcall sloop::below sloop::above sloop::to :sloop-for :sloop-map "LIM" lisp::> lisp::< lisp::>= lisp::<= lisp::fixnum "increment must be constant." 2147483647 -2147483648 (sloop::type-error) (sloop::local-finish) :sloop-for-args "sloop-for macro needs at least one arg" :sloop-macro-args lisp::&rest "Sorry only one allowed loop-map per sloop" :sloop-map-args "map needs one arg before the key word" "Build this in two steps if you want &rest" :sloop-body :sloop-map-declares :upcase lisp::*print-case* "~a-SLOOP-~a" "need more args" "need less args" lisp::eval-when (lisp::load lisp::compile lisp::eval) lisp::defun lisp::pushnew "SLOOP-~a" lisp::keyword "SLOOP-~a-ARGS" lisp::setq lisp::logxor lisp::if lisp::max lisp::min lisp::1+ (sloop::loop-return lisp::nil) (sloop::loop-return lisp::nil) sloop::.average. lisp::nil sloop::.n-to-average. (lisp::float sloop::.average.) (lisp::fixnum sloop::.n-to-average.) lisp::/ (lisp::* sloop::.n-to-average. sloop::.average.) (lisp::incf sloop::.n-to-average.) (sloop::finally (sloop::loop-return sloop::.average.)) lisp::maphash lisp::function lisp::lambda (:sloop-map-declares :sloop-body) lisp::do-symbols lisp::find-package "INDEX" (sloop::from sloop::downfrom) (sloop::to sloop::below sloop::above) lisp::length lisp::aref sloop::then "FINISH" (lisp::quote lisp::go) (sloop::next-loop) ((lisp::go sloop::next-loop)) "POINT" lisp::atom (sloop::local-finish) "First must be followed by then" "First must be followed by then" sloop::*collate-order* lisp::multiple-value-bind (sloop::after sloop::already-there) sloop::find-in-ordered-list sloop::already-there sloop::after (lisp::cdr sloop::after) (lisp::cdr sloop::after) lisp::labels sloop::map-fringe-aux (sloop::.xtree.) sloop::.xtree. (:sloop-map-declares :sloop-body) sloop::desetq1 sloop::parse-loop sloop::def-loop-internal lisp::find sloop::already-un-popped sloop::parse-loop1 sloop::substitute-sloop-body sloop::loop-let-bindings sloop::loop-peek sloop::loop-pop sloop::parse-no-body sloop::parse-loop-for sloop::parse-loop-do sloop::parse-loop-when sloop::loop-collect-keyword-p sloop::parse-loop-collect sloop::parse-loop-initially sloop::parse-loop-with sloop::parse-loop-declare sloop::parse-loop-macro sloop::loop-un-pop sloop::loop-add-binding sloop::loop-add-temps sloop::parse-one-when-clause sloop::pointer-for-collect sloop::loop-parse-additional-collections sloop::make-value sloop::loop-declare-binding sloop::add-from-data sloop::parse-loop-map sloop::the-type lisp::subtypep (system::%init . #((system::warn-version 608) (system::*make-special (lisp::quote sloop::*use-locatives*)) (system::putprop (lisp::quote sloop::*use-locatives*) "See sloop.lisp" #0=(lisp::quote system::variable-documentation)) (lisp::or (lisp::boundp (lisp::quote sloop::*use-locatives*)) (lisp::setq sloop::*use-locatives* lisp::nil)) (system::*make-special (lisp::quote sloop::*automatic-declarations*)) (system::putprop (lisp::quote sloop::*automatic-declarations*) "See sloop.lisp" #0#) (lisp::or (lisp::boundp (lisp::quote sloop::*automatic-declarations*)) (lisp::setq sloop::*automatic-declarations* (lisp::quote (:from lisp::fixnum)))) (system::*make-special (lisp::quote sloop::*auto-type*)) (lisp::or (lisp::boundp (lisp::quote sloop::*auto-type*)) (lisp::setq sloop::*auto-type* (lisp::quote (:from :in :collect)))) (system::*make-special (lisp::quote sloop::*auto-register*)) (lisp::or (lisp::boundp (lisp::quote sloop::*auto-register*)) (lisp::setq sloop::*auto-register* (lisp::quote (:from :in :collect)))) (lisp::proclaim (lisp::quote (lisp::declaration :register))) (system::*make-special (lisp::quote sloop::*type-check*)) (system::putprop (lisp::quote sloop::*type-check*) "If t adds a type check on bounds of from loop
  11. if there is and automatic declare" #0#) (lisp::or (lisp::boundp (lisp::quote sloop::*type-check*)) (lisp::setq sloop::*type-check* lisp::t)) (system::*make-special (lisp::quote sloop::*macroexpand-hook-for-no-copy*)) (lisp::or (lisp::boundp (lisp::quote sloop::*macroexpand-hook-for-no-copy*)) (lisp::setq sloop::*macroexpand-hook-for-no-copy* (lisp::quote lisp::funcall))) (system::*make-special (lisp::quote sloop::*sloop-translations*)) (system::putprop (lisp::quote sloop::*sloop-translations*) "A list of cons's where the translation is the cdr, and the car
  12. is a list of names or name to be translated.  Essentially allows 'globalizing'
  13. a symbol for the purposes of being a keyword in a sloop" (lisp::quote system::variable-documentation)) (lisp::setq sloop::*sloop-translations* (lisp::quote ((sloop::appending . lisp::append) ((sloop::collecting sloop::collect) . sloop::collect) ((sloop::maximizing sloop::maximize) . sloop::maximize) ((sloop::minimizing sloop::minimize) . sloop::minimize) (sloop::nconcing . lisp::nconc) ((lisp::count sloop::counting) . lisp::count) (sloop::summing . sloop::sum) (lisp::if . lisp::when) (sloop::as . sloop::for) (sloop::in-fringe . sloop::in-fringe) (sloop::collate . sloop::collate) (sloop::in-table . sloop::in-table) (sloop::in-carefully . sloop::in-carefully) (sloop::averaging . sloop::averaging) (sloop::repeat . sloop::repeat) (sloop::first-use . sloop::first-use) (sloop::in-array . sloop::in-array)))) (system::*make-special (lisp::quote sloop::*additional-collections*)) (lisp::setq sloop::*additional-collections* lisp::nil) (system::putprop (lisp::quote sloop::lcase) (lisp::quote 1) #1=(lisp::quote system::pretty-print-format)) (system::mm (lisp::quote sloop::lcase) 0) (system::mfsfun (lisp::quote sloop::desetq1) 1 2) (system::mm (lisp::quote sloop::desetq) 2) (system::mm (lisp::quote sloop::loop-return) 3) (system::mm (lisp::quote sloop::loop-finish) 4) (system::mm (lisp::quote sloop::local-finish) 5) (system::putprop (lisp::quote sloop::sloop) (lisp::quote 0) #1#) (system::mm (lisp::quote sloop::sloop) 6) (system::putprop (lisp::quote sloop::def-loop-map) (lisp::quote 2) #1#) (system::mm (lisp::quote sloop::def-loop-map) 7) (system::putprop (lisp::quote sloop::def-loop-for) (lisp::quote 2) #1#) (system::mm (lisp::quote sloop::def-loop-for) 8) (system::putprop (lisp::quote sloop::def-loop-macro) (lisp::quote 2) #1#) (system::mm (lisp::quote sloop::def-loop-macro) 9) (system::putprop (lisp::quote sloop::def-loop-collect) "Define function of 2 args arglist= (collect-var value-to-collect)" (lisp::quote system::function-documentation)) (system::putprop (lisp::quote sloop::def-loop-collect) (lisp::quote 2) #1#) (system::mm (lisp::quote sloop::def-loop-collect) 10) (system::mm (lisp::quote sloop::sloop-swap) 11) (system::mfsfun (lisp::quote sloop::l-equal) 12 2) (system::mfsfun (lisp::quote sloop::loop-collect-keyword-p) 13 1) (system::mfsfun (lisp::quote sloop::translate-name) 14 1) (system::mfsfun (lisp::quote sloop::loop-pop) 15 0) (system::mfsfun (lisp::quote sloop::loop-un-pop) 16 0) (system::mfsfun (lisp::quote sloop::loop-peek) 17 0) (system::mfsfun (lisp::quote sloop::loop-let-bindings) 18 1) (system::mfsfun (lisp::quote sloop::parse-loop) 19 1) (system::mfsfun (lisp::quote sloop::parse-loop1) 20 0) (system::putprop (lisp::quote sloop::parse-no-body) "Reads successive no-body-contribution type forms, like declare,
  14. initially, etc.  which can occur anywhere. Returns t if it finds some
  15. otherwise nil" #2=(lisp::quote system::function-documentation)) (system::mfsfun (lisp::quote sloop::parse-no-body) 21 1) (system::mfvfun (lisp::quote sloop::parse-loop-with) 22 512) (system::mfsfun (lisp::quote sloop::parse-loop-do) 23 0) (system::mfsfun (lisp::quote sloop::parse-loop-initially) 24 1) (system::mfsfun (lisp::quote sloop::parse-one-when-clause) 25 0) (system::mfsfun (lisp::quote sloop::parse-loop-when) 26 0) (system::mfsfun (lisp::quote sloop::pointer-for-collect) 27 1) (system::mfsfun (lisp::quote sloop::parse-loop-collect) 28 0) (system::mfsfun (lisp::quote sloop::loop-parse-additional-collections) 29 3) (system::mfsfun (lisp::quote sloop::the-type) 30 2) (system::mfsfun (lisp::quote sloop::type-error) 31 0) (system::mfsfun (lisp::quote sloop::make-value) 32 2) (system::mfvfun (lisp::quote sloop::loop-add-binding) 33 1794) (system::mfvfun (lisp::quote sloop::loop-declare-binding) 34 1027) (system::mfvfun (lisp::quote sloop::parse-loop-declare) 35 512) (system::mfvfun (lisp::quote sloop::loop-add-temps) 36 1281) (system::putprop (lisp::quote sloop::add-from-data) "rest = var begin end  incr direction or-eql" #2#) (system::mfvfun (lisp::quote sloop::add-from-data) 37 16385) (system::mfsfun (lisp::quote sloop::parse-loop-for) 38 0) (system::mfvfun (lisp::quote sloop::parse-loop-macro) 39 770) (system::mfsfun (lisp::quote sloop::parse-loop-map) 40 2) (system::mfsfun (lisp::quote sloop::substitute-sloop-body) 41 1) (system::mfvfun (lisp::quote sloop::def-loop-internal) 42 1796) (system::mfsfun (lisp::quote sloop::sum-sloop-collect) 43 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote sloop::sum) sloop::*additional-collections*)) (system::sputprop (lisp::quote sloop::sum) :sloop-collect (lisp::quote sloop::sum-sloop-collect)) (system::sputprop (lisp::quote sloop::sum) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::mfsfun (lisp::quote sloop::logxor-sloop-collect) 44 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote lisp::logxor) sloop::*additional-collections*)) (system::sputprop (lisp::quote lisp::logxor) :sloop-collect (lisp::quote sloop::logxor-sloop-collect)) (system::sputprop (lisp::quote lisp::logxor) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::mfsfun (lisp::quote sloop::maximize-sloop-collect) 45 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote sloop::maximize) sloop::*additional-collections*)) (system::sputprop (lisp::quote sloop::maximize) :sloop-collect (lisp::quote sloop::maximize-sloop-collect)) (system::sputprop (lisp::quote sloop::maximize) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::mfsfun (lisp::quote sloop::minimize-sloop-collect) 46 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote sloop::minimize) sloop::*additional-collections*)) (system::sputprop (lisp::quote sloop::minimize) :sloop-collect (lisp::quote sloop::minimize-sloop-collect)) (system::sputprop (lisp::quote sloop::minimize) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::mfsfun (lisp::quote sloop::count-sloop-collect) 47 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote lisp::count) sloop::*additional-collections*)) (system::sputprop (lisp::quote lisp::count) :sloop-collect (lisp::quote sloop::count-sloop-collect)) (system::sputprop (lisp::quote lisp::count) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::mfsfun (lisp::quote sloop::thereis-sloop-collect) 48 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote sloop::thereis) sloop::*additional-collections*)) (system::sputprop (lisp::quote sloop::thereis) :sloop-collect (lisp::quote sloop::thereis-sloop-collect)) (system::sputprop (lisp::quote sloop::thereis) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::mfsfun (lisp::quote sloop::always-sloop-collect) 49 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote sloop::always) sloop::*additional-collections*)) (system::sputprop (lisp::quote sloop::always) :sloop-collect (lisp::quote sloop::always-sloop-collect)) (system::sputprop (lisp::quote sloop::always) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::mfsfun (lisp::quote sloop::never-sloop-collect) 50 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote sloop::never) sloop::*additional-collections*)) (system::sputprop (lisp::quote sloop::never) :sloop-collect (lisp::quote sloop::never-sloop-collect)) (system::sputprop (lisp::quote sloop::never) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::setvv 204 (lisp::* 0.0F0 lisp::least-positive-long-float)) (system::mfsfun (lisp::quote sloop::averaging-sloop-macro) 51 1) (system::sputprop (lisp::quote sloop::averaging) :sloop-macro (lisp::quote sloop::averaging-sloop-macro)) (system::sputprop (lisp::quote sloop::averaging) :sloop-macro-args (lisp::quote (sloop::x))) (system::mfsfun (lisp::quote sloop::repeat-sloop-macro) 52 1) (system::sputprop (lisp::quote sloop::repeat) :sloop-macro (lisp::quote sloop::repeat-sloop-macro)) (system::sputprop (lisp::quote sloop::repeat) :sloop-macro-args (lisp::quote (sloop::x))) (system::mfsfun (lisp::quote sloop::return-sloop-macro) 53 1) (system::sputprop (lisp::quote lisp::return) :sloop-macro (lisp::quote sloop::return-sloop-macro)) (system::sputprop (lisp::quote lisp::return) :sloop-macro-args (lisp::quote (sloop::x))) (system::mfsfun (lisp::quote sloop::in-table-sloop-map) 54 2) (system::sputprop (lisp::quote sloop::in-table) :sloop-map (lisp::quote sloop::in-table-sloop-map)) (system::sputprop (lisp::quote sloop::in-table) :sloop-map-args (lisp::quote (sloop::var sloop::table))) (system::mfsfun (lisp::quote sloop::in-package-sloop-map) 55 2) (system::sputprop (lisp::quote lisp::in-package) :sloop-map (lisp::quote sloop::in-package-sloop-map)) (system::sputprop (lisp::quote lisp::in-package) :sloop-map-args (lisp::quote (sloop::var sloop::pkg))) (system::mfvfun (lisp::quote sloop::in-array-sloop-for) 56 16386) (system::sputprop (lisp::quote sloop::in-array) :sloop-for (lisp::quote sloop::in-array-sloop-for)) (system::sputprop (lisp::quote sloop::in-array) :sloop-for-args (lisp::quote (sloop::vars lisp::array lisp::&rest sloop::args))) (system::mfsfun (lisp::quote sloop::=-sloop-for) 57 2) (system::sputprop (lisp::quote lisp::=) :sloop-for (lisp::quote sloop::=-sloop-for)) (system::sputprop (lisp::quote lisp::=) :sloop-for-args (lisp::quote (sloop::var sloop::val))) (system::mfsfun (lisp::quote sloop::sloop-sloop-macro) 58 1) (system::sputprop (lisp::quote sloop::sloop) :sloop-macro (lisp::quote sloop::sloop-sloop-macro)) (system::sputprop (lisp::quote sloop::sloop) :sloop-macro-args (lisp::quote (sloop::for-loop))) (system::putprop (lisp::quote sloop::in-carefully-sloop-for) "Path with var in lis except lis may end with a non nil cdr" #2#) (system::mfsfun (lisp::quote sloop::in-carefully-sloop-for) 59 2) (system::sputprop (lisp::quote sloop::in-carefully) :sloop-for (lisp::quote sloop::in-carefully-sloop-for)) (system::sputprop (lisp::quote sloop::in-carefully) :sloop-for-args (lisp::quote (sloop::var sloop::lis))) (system::mfsfun (lisp::quote sloop::first-use-sloop-for) 60 4) (system::sputprop (lisp::quote sloop::first-use) :sloop-for (lisp::quote sloop::first-use-sloop-for)) (system::sputprop (lisp::quote sloop::first-use) :sloop-for-args (lisp::quote (sloop::var sloop::expr1 sloop::then sloop::expr2))) (system::mfsfun (lisp::quote sloop::first-sloop-for) 61 4) (system::sputprop (lisp::quote lisp::first) :sloop-for (lisp::quote sloop::first-sloop-for)) (system::sputprop (lisp::quote lisp::first) :sloop-for-args (lisp::quote (sloop::var sloop::expr1 sloop::then sloop::expr2))) (system::*make-special (lisp::quote sloop::*collate-order*)) (lisp::or (lisp::boundp (lisp::quote sloop::*collate-order*)) (lisp::setq sloop::*collate-order* (lisp::function lisp::<))) (system::mf (lisp::quote sloop::find-in-ordered-list) 62) (system::putprop (lisp::quote sloop::collate-sloop-collect) "Collects values into a sorted list without duplicates.
  16. Order based order function *collate-order*" #2#) (system::mfsfun (lisp::quote sloop::collate-sloop-collect) 63 2) (lisp::setq sloop::*additional-collections* (lisp::adjoin (lisp::quote sloop::collate) sloop::*additional-collections*)) (system::sputprop (lisp::quote sloop::collate) :sloop-collect (lisp::quote sloop::collate-sloop-collect)) (system::sputprop (lisp::quote sloop::collate) :sloop-collect-args (lisp::quote (sloop::ans sloop::val))) (system::putprop (lisp::quote sloop::in-fringe-sloop-map) "Map over the non nil atoms in the fringe of tree" #2#) (system::mfsfun (lisp::quote sloop::in-fringe-sloop-map) 64 2) (system::sputprop (lisp::quote sloop::in-fringe) :sloop-map (lisp::quote sloop::in-fringe-sloop-map)) (system::sputprop (lisp::quote sloop::in-fringe) :sloop-map-args (lisp::quote (sloop::var sloop::tree))))))
  17. )
  18.